C---------------------------------------------------------
C    TOOLPACK/1    Release: 3.1
C---------------------------------------------------------
C
C  TOKEN STREAM BASED NAME CHANGER
C
      PROGRAM ISTCN
 
      INTEGER SRCIN, SRCOUT, CMDFIL, OPTFIL, STATUS, NEXT
      INTEGER TKNIN, TKNOUT, CMTIN, CMTOUT
      INTEGER TKNINM(81), TKNONM(81),
     +        CMTINM(81), CMTONM(81)
      INTEGER SRCINM(81), SRCONM(81), CMDNAM(81),
     +        OPTNAM(81)
      LOGICAL INSRC, OUTSRC
      INTEGER OPEN, CREATE, GETARG, READCF
 
C  Read paths from command file
 
      CALL ZINIT
 
      IF (GETARG(1,CMDNAM,81).EQ.-100) CALL NAMES(1,CMDNAM)
      CMDFIL=OPEN(CMDNAM,0)
      IF (CMDFIL.EQ.-1)
     +          CALL ERROR('[ISTCN unable to open command file].')
      STATUS = READCF(CMDFIL, INSRC, OUTSRC)
      CALL CLOSE(CMDFIL)
      IF(STATUS .NE. -2) THEN
        CALL ZMESS('[ISTCN - Terminated in Error].', 1)
        CALL ZQUIT(STATUS)
      ENDIF
 
      IF(INSRC) THEN
        IF (GETARG(2,SRCINM,81).EQ.-100) CALL NAMES(2, SRCINM)
        SRCIN =OPEN(SRCINM,0)
        IF (SRCIN .EQ.-1)
     +        CALL ERROR('[ISTCN unable to open input file].')
        NEXT = 3
      ELSE
        IF (GETARG(2,TKNINM,81).EQ.-100) CALL NAMES(3,TKNINM)
        IF (GETARG(3,CMTINM,81).EQ.-100) CALL NAMES(4,CMTINM)
        TKNIN =OPEN(TKNINM,0)
        IF (TKNIN .EQ.-1)
     +      CALL ERROR('[ISTCN unable to open input token file].')
        CMTIN =OPEN(CMTINM,0)
        IF (CMTIN .EQ.-1)
     +      CALL ERROR('[ISTCN unable to open input comment file].')
        NEXT = 4
      ENDIF
 
      IF(OUTSRC) THEN
        IF (GETARG(NEXT,SRCONM,81).EQ.-100) CALL NAMES(5, SRCONM)
        IF (GETARG(NEXT+1,OPTNAM,81).EQ.-100) CALL NAMES(6, OPTNAM)
        SRCOUT=CREATE(SRCONM,1)
        IF (SRCOUT.EQ.-1)
     +      CALL ERROR('[ISTCN unable to open output file].')
        IF(OPTNAM(1) .NE. 45) THEN
          OPTFIL=OPEN(OPTNAM,0)
          IF (OPTFIL.EQ.-1)
     +          CALL ERROR('[ISTCN unable to open option file].')
          CALL PLOPTF(OPTFIL)
          CALL CLOSE(OPTFIL)
        ENDIF
      ELSE
        IF (GETARG(NEXT,TKNONM,81).EQ.-100) CALL NAMES(7,TKNONM)
        IF (GETARG(NEXT+1,CMTONM,81).EQ.-100) CALL NAMES(8,CMTONM)
        TKNOUT=CREATE(TKNONM,1)
        IF (TKNOUT.EQ.-1)
     +      CALL ERROR('[ISTCN unable to open output token file].')
        CMTOUT=CREATE(CMTONM,1)
        IF (CMTOUT.EQ.-1)
     +      CALL ERROR('[ISTCN unable to open output comment file].')
      ENDIF
 
      CALL TRNSFR(INSRC, OUTSRC, SRCIN,  TKNIN,  CMTIN,
     +                           SRCOUT, TKNOUT, CMTOUT, STATUS)
 
      IF(STATUS .EQ. -2) THEN
        CALL ZMESS('[ISTCN - Normal Termination].', 1)
      ELSE IF (STATUS .EQ. -1002) THEN
        CALL ZMESS('[ISTCN - Warnings Notified].', 1)
      ELSE
        CALL ZMESS('[ISTCN - Errors Notified].', 1)
      ENDIF
      CALL ZQUIT(STATUS)
 
      END
C-----------------------------------------------------------
C
C  PROMPT THE USER FOR NAMES THAT HAVE NOT BEEN SUPPLIED.......
C
C  1 = COMMAND FILE
C  2 = INPUT SOURCE
C  3 = INPUT TOKEN STREAM
C  4 = INPUT COMMENT STREAM
C  5 = OUTPUT SOURCE
C  6 = POLISH OPTION FILE
C  7 = OUTPUT TOKEN STREAM
C  8 = OUTPUT COMMENT STREAM
C
      SUBROUTINE NAMES (NUMB,PATH)
 
      INTEGER NUMB,PATH(*)
 
      INTEGER ZGTCMD
      INTEGER JUNK,PROMPT(22,8)
 
      DATA (PROMPT(I,1),I=1,15)/67,111,109,109,97,110,
     +100,32,102,105,108,101,58,32,129/
 
      DATA (PROMPT(I,2),I=1,13)/73,110,112,117,116,32,
     +102,105,108,101,58,32,129/
     +(PROMPT(I,3),I=1,19)/73,110,112,117,116,32,
     +116,111,107,101,110,32,102,105,108,101,58,32,129/
     +(PROMPT(I,4),I=1,21)/73,110,112,117,116,32,99,
     +111,109,109,101,110,116,32,102,105,108,101,58,32,129/
 
      DATA (PROMPT(I,5),I=1,14)/79,117,116,112,117,116,32,
     +102,105,108,101,58,32,129/
     +(PROMPT(I,6),I=1,14)/79,112,116,105,111,110,
     +32,102,105,108,101,58,32,129/
     +(PROMPT(I,7),I=1,20)/79,117,116,112,117,116,32,
     +116,111,107,101,110,32,102,105,108,101,58,32,129/
     +(PROMPT(I,8),I=1,22)/79,117,116,112,117,116,32,
     +99,111,109,109,101,110,116,32,102,105,
     +108,101,58,32,129/
 
      CALL ZPRMPT(PROMPT(1,NUMB))
      JUNK=ZGTCMD(PATH,0)
 
      RETURN
      END
C-----------------------------------------------------------
C
C  READ THE COMMAND FILE, THIS MAY BE INTERACTIVE SO HAVE A PROMPT
C  READY. EACH LINE MAY BE EITHER A COMMENT OR A CHANGE REQUEST, THE
C  FIRST IS EASY, THE SECOND LESS SO....
C
      INTEGER FUNCTION READCF(FD, INSRC, OUTSRC)
 
      INTEGER FD, STATUS, I, J
      INTEGER BUFFER(134), PROMPT(10), TMPST1(134), TMPST2(134)
      INTEGER ZGTCMD, ZLOWER, ZSPLIT, ZCOMPP, ZREPLS
      LOGICAL INSRC, OUTSRC
      INTEGER PATSTR(256, 2, 256), REPSTR(256, 256)
      INTEGER LIMIT
      LOGICAL WHICH(5, 256)
      COMMON /PATS/ PATSTR, REPSTR, LIMIT, WHICH
 
      SAVE /PATS/
 
      DATA PROMPT/67,111,109,109,97,110,100,58,32,129/
 
      READCF = -1
      LIMIT  = 0
      INSRC = .FALSE.
      OUTSRC = .FALSE.
 
   10 CONTINUE
        IF(FD .EQ. 0) CALL ZPRMPT(PROMPT)
        STATUS = ZGTCMD(BUFFER, FD)
        IF(STATUS .EQ. -100) THEN
          IF(LIMIT .GT. 0) READCF = -2
 
        ELSE IF(STATUS .NE. -1) THEN
          IF(BUFFER(1) .EQ. 60) THEN
            IF(ZLOWER(BUFFER(2)) .NE. 115) THEN
              INSRC = .FALSE.
            ELSE
              INSRC = .TRUE.
            ENDIF
            GO TO 10
          ELSE IF(BUFFER(1) .EQ. 62) THEN
            IF(ZLOWER(BUFFER(2)) .NE. 115) THEN
              OUTSRC = .FALSE.
            ELSE
              OUTSRC = .TRUE.
            ENDIF
            GO TO 10
 
          ELSE IF(BUFFER(1) .NE. 35 .AND. STATUS .GT. 7) THEN
            LIMIT = LIMIT + 1
            IF(LIMIT .GT. 256) CALL ERROR('[ISTCN: Too many changes].')
C
C  CHECK TO SEE IF THE CHANGE IS TO BE APPLIED TO TNAME TOKENS
C
            I = 1
            CALL SKIPBL(BUFFER, I)
            IF(ZLOWER(BUFFER(I)) .EQ. 116) THEN
              WHICH(1, LIMIT) = .TRUE.
            ELSE
              WHICH(1, LIMIT) = .FALSE.
            ENDIF
C
C  CHECK TO SEE IF THE CHANGE IS TO BE APPLIED TO TCMMNT TOKENS
C
            I = I + 1
            CALL SKIPBL(BUFFER, I)
            IF(ZLOWER(BUFFER(I)) .EQ. 116) THEN
              WHICH(2, LIMIT) = .TRUE.
            ELSE
              WHICH(2, LIMIT) = .FALSE.
            ENDIF
C
C  CHECK TO SEE IF THE CHANGE IS TO BE APPLIED TO TCCNST TOKENS
C
            I = I + 1
            CALL SKIPBL(BUFFER, I)
            IF(ZLOWER(BUFFER(I)) .EQ. 116) THEN
              WHICH(3, LIMIT) = .TRUE.
            ELSE
              WHICH(3, LIMIT) = .FALSE.
            ENDIF
C
C  CHECK TO SEE IF THE CHANGE IS TO BE APPLIED TO THCNST TOKENS
C
            I = I + 1
            CALL SKIPBL(BUFFER, I)
            IF(ZLOWER(BUFFER(I)) .EQ. 116) THEN
              WHICH(4, LIMIT) = .TRUE.
            ELSE
              WHICH(4, LIMIT) = .FALSE.
            ENDIF
C
C  CHECK TO SEE IF CASE FOLDING IS REQUIRED
C
            I = I + 1
            CALL SKIPBL(BUFFER, I)
            IF(ZLOWER(BUFFER(I)) .EQ. 116) THEN
              WHICH(5, LIMIT) = .TRUE.
            ELSE
              WHICH(5, LIMIT) = .FALSE.
            ENDIF
C
C  SEPARATE OUT THE REGULAR EXPRESSION AND REPLACEMENT PATTERN.....
C
            I = I + 1
            CALL SKIPBL(BUFFER, I)
            IF(ZSPLIT(BUFFER(I), TMPST1, TMPST2) .NE. -1) THEN
              IF(ZCOMPP(TMPST1,WHICH(5,LIMIT),PATSTR(1,1,LIMIT))
     +           .EQ.-1) CALL ERROR('[ISTCN: Pattern Error 2].')
              IF(ZREPLS(TMPST2, REPSTR(1, LIMIT)) .EQ. -1)
     +           CALL ERROR('[ISTCN: Pattern Error 3].')
              TMPST2(1) = 37
              CALL SCOPY(TMPST1, 1, TMPST2, 2)
              J = LENGTH(TMPST2)
              TMPST2(J+1) = 36
              TMPST2(J+2) = 129
              IF(ZCOMPP(TMPST2,WHICH(5,LIMIT),PATSTR(1,2,LIMIT))
     +           .EQ.-1) CALL ERROR('[ISTCN: Replacement Error].')
              GO TO 10
            ELSE
              CALL ERROR('[ISTCN: Pattern Error 1].')
            ENDIF
          ELSE
            GO TO 10
          ENDIF
        ELSE
          CALL ERROR('[ISTCN: Command Input Error].')
 
        ENDIF
 
      END
C-----------------------------------------------------------
C
C  TOKEN STREAM EDITOR, COPIES THE INPUT TOKEN STREAM TO THE
C  OUTPUT TOKEN STREAM APPLYING ALL THE REQUESTED CHANGES EN ROUTE.
C
      SUBROUTINE TRNSFR(INSRC, OUTSRC, SRCIN,  TKNIN,  CMTIN,
     +                         SRCOUT, TKNOUT, CMTOUT, STATE)
 
      LOGICAL INSRC, OUTSRC, TEST1, TEST2
      INTEGER SRCIN,  TKNIN,  CMTIN, SRCOUT, TKNOUT, CMTOUT
      INTEGER STATE, CHOICE
      INTEGER TKNTYP, TKNLEN, STATUS, I, J, DESCI, DESCO
      INTEGER TKNSTR(1322), BUFFER(1322), TEMP(134)
      INTEGER LENGTH, ZSTRRP, ZTKGTI, ZTKPTI
 
      INTEGER PATSTR(256, 2, 256), REPSTR(256, 256)
      INTEGER LIMIT
      LOGICAL WHICH(5, 256)
      COMMON /PATS/ PATSTR, REPSTR, LIMIT, WHICH
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
      SAVE /PATS/
 
      STATE = -2
      IF(INSRC) THEN
        DESCI = ZTKGTI(0, SRCIN,  -1)
      ELSE
        DESCI = ZTKGTI(1, TKNIN, CMTIN)
      ENDIF
      IF(OUTSRC) THEN
        I=ZTKGTI(2,J,DESCO)
        DESCO = ZTKPTI(0, SRCOUT, I)
      ELSE
        DESCO = ZTKPTI(1, TKNOUT, CMTOUT)
      ENDIF
      IF(DESCI .LE. 0 .OR. DESCO .LE. 0) RETURN
 
   10 CONTINUE
        IF(INSRC) THEN
          CALL ZSCAN(TKNTYP,TKNLEN,TKNSTR,DESCI,STATUS)
        ELSE
          CALL ZGETTK(TKNTYP,TKNLEN,TKNSTR,DESCI,STATUS)
        ENDIF
        IF(TKNTYP .EQ. TNAME .OR. TKNTYP .EQ. TCMMNT .OR.
     +     TKNTYP .EQ. TCCNST.OR. TKNTYP .EQ. THCNST) THEN
          DO 20 I = 1, LIMIT
            IF((TKNTYP .EQ. TNAME  .AND. WHICH(1, I)) .OR.
     +         (TKNTYP .EQ. TCMMNT .AND. WHICH(2, I)) .OR.
     +         (TKNTYP .EQ. TCCNST .AND. WHICH(3, I)) .OR.
     +         (TKNTYP .EQ. THCNST .AND. WHICH(4, I))) THEN
              IF(TKNTYP .NE. TNAME) THEN
                CHOICE = 1
              ELSE
                CHOICE = 2
              ENDIF
              STATUS = ZSTRRP(TKNSTR, BUFFER, .TRUE.,
     +                 PATSTR(1, CHOICE, I), REPSTR(1, I))
              IF(STATUS .EQ. -2) CALL SCOPY(BUFFER, 1, TKNSTR, 1)
            ENDIF
   20     CONTINUE
          TKNLEN = LENGTH(TKNSTR)
        ENDIF
        IF(TKNTYP .EQ. TNAME) THEN
          CALL ZLEGAL(TKNSTR, TEST1, TEST2)
          IF(.NOT. TEST1) THEN
            IF(TEST2)THEN
              CALL ZCHOUT
     +              ('CN: Warning, name is non-standard: .', 1)
              CALL ZPTMES(TKNSTR, 1)
              IF(STATE .EQ. -2) STATE = -1002
            ELSE
              CALL ZCHOUT
     +              ('CN: Error, name is illegal: .', 1)
              CALL ZPTMES(TKNSTR, 1)
              STATE = -1
            ENDIF
          ENDIF
        ENDIF
        IF(OUTSRC) THEN
          CALL ZUSCAN(TKNTYP, TKNLEN, TKNSTR, DESCO)
        ELSE
          CALL ZPUTTK(TKNTYP, TKNLEN, TKNSTR, DESCO)
        ENDIF
      IF(TKNTYP .NE. TZEOF) GO TO 10
 
      END
